﻿namespace RLab.Programming

open System
open Microsoft.FSharp.Text.Lexing
open Ast

module TypeConverter = 
    let toName value = 
        match value with
        | Int _ -> "INT"
        | Float _ -> "REAL"
        | String _ -> "STRING"
        | _ -> failwith "expression is not evaluated."
    let toInt value = 
        match value with 
        | Int a -> a
        | _ -> failwithf "unexpected expression type. Expected INT but given %A" (toName value)
    let toSingle value = 
        match value with
        | Int v -> single v 
        | Float v -> single v 
        | _ -> failwith "cannot convert expression to real"
    let toBool value = 
        match value with        
        | Float v -> v <> 0.0
        | Int v -> v <> 0        
        | _ -> failwith "cannot convert expression to bool"
    let toVal b = if b then Int(1) else Int(0)    

    let (|FloatPair|IntPair|OtherPair|)  (ex1,ex2) = 
        match ex1,ex2 with
        | Int v1,Int v2     -> IntPair(v1,v2)
        | Int v1,Float v2   -> FloatPair((double v1),v2)
        | Float v1,Int v2   -> FloatPair(v1,(double  v2))
        | Float v1,Float v2 -> FloatPair(v1,v2)
        | _ -> OtherPair
    let computeExpression ex1 ex2 intOp doubleOp =        
        match ex1,ex2 with
        | IntPair (v1,v2)   -> intOp     v1 v2
        | FloatPair (v1,v2) -> doubleOp  v1 v2
        | OtherPair -> failwith "unsupported argument type"
    let computeNumericExpression ex1 ex2 intOp doubleOp =        
        computeExpression ex1 ex2
            (fun a b -> Int  ( intOp    a b))
            (fun a b -> Float( doubleOp a b))
    let computeBooleanExpression ex1 ex2 intOp doubleOp = 
        computeExpression ex1 ex2
            (fun a b -> toVal <| intOp    a b) 
            (fun a b -> toVal <| doubleOp a b)                      
    let (.+) a b = 
        match a,b with
        | IntPair (v1,v2)     -> Int   (v1 + v2)
        | FloatPair (v1,v2)   -> Float (v1 + v2)
        | String v1,String v2 -> String(v1 + v2)
        | _ -> failwith "unsupported argument type"
open TypeConverter

module Interpeter =     
    let Execute txt programmable (observer : IObserver<ProgrammableEventArgs>)=        
        let event = new Event<ProgrammableEventArgs>() //change to IObservable
        let unsubsrciber = event.Publish.Subscribe(observer)
        try                
            let evaluateAst (programmable : IProgrammable) program  =                 
                let tb = toBool    
                let cne = computeNumericExpression
                let cbe = computeBooleanExpression
                let inline  (^||) a b = (not a) && b || (not b) && a                
                let rec evalE (env: Map<string, expr>) = function                    
                    | Id v -> if env.ContainsKey v then env.[v] else failwith ("unbound variable: " + v)
                    | String _ | Int _ | Float _ as x -> x

                    | Add (e1, e2) ->  (evalE env e1) .+ (evalE env e2)
                    | Sub (e1, e2) -> cne (evalE env e1) (evalE env e2) (-) (-)
                    | Mul (e1, e2) -> cne (evalE env e1) (evalE env e2) (*) (*)
                    | Div (e1, e2) -> cne (evalE env e1) (evalE env e2) (/) (/)

                    | Equals (e1,e2) ->  cbe (evalE env e1) (evalE env e2) (=) (=)
                    | NotEquals (e1,e2) -> cbe (evalE env e1) (evalE env e2) (<>) (<>)
                    | GreaterOrEquals (e1,e2) -> cbe (evalE env e1) (evalE env e2) (>=) (>=)
                    | LessOrEquals (e1,e2) -> cbe (evalE env e1) (evalE env e2) (<=) (<=)
                    | Greater (e1,e2) -> cbe (evalE env e1) (evalE env e2) (>) (>)
                    | Less (e1,e2) -> cbe (evalE env e1) (evalE env e2) (<) (<)

                    | Not (e1)    ->    e1 |> (evalE env) |> tb   |> not                         |> toVal
                    | And (e1,e2) -> ( (e1 |> (evalE env) |> tb)  && (e2 |> (evalE env) |> tb) ) |> toVal
                    | Or  (e1,e2) -> ( (e1 |> (evalE env) |> tb)  || (e2 |> (evalE env) |> tb) ) |> toVal
                    | Xor (e1,e2) -> ( (e1 |> (evalE env) |> tb) ^|| (e2 |> (evalE env) |> tb) ) |> toVal
                and eval env = function
                    | Assign (v, e) ->
                        let value = evalE env e
                        match v.[0],value with
                        | '$', String(s) -> env.Add(v, value)
                        | '$', _ -> failwithf "unable to assign %A to a string variable" (toName value)                        
                        | _ -> env.Add(v, value)
                    | While (e, body) ->
                        let rec loop env e body =
                            if tb (evalE env e) then
                                loop (eval env body) e body
                            else env
                        loop env e body
                    | IfThen (e, stmt) ->
                        if tb(evalE env e) then eval env stmt else env
                    | IfThenElse (e, stmt1, stmt2) ->
                        if tb(evalE env e) then eval env stmt1 else eval env stmt2
                    | Drive (i,f,v) -> programmable.Drive (toInt(evalE env i)) (toSingle(evalE env f)) (toSingle(evalE env v)) ; env
                    | Base -> programmable.Base(); env
                    | Open -> programmable.OpenTool(); env
                    | Close -> programmable.CloseTool(); env
                    | Seq (list) -> List.fold eval env list
                    | Type(e) -> 
                        let message =                            
                            match (evalE env e) with
                            | String value     -> value
                            | Int    value     -> value.ToString()
                            | Float  value     -> value.ToString()
                            | _ -> failwith "Unexpected expression evaluation result"
                        programmable.Type(message);env
                match program with
                | Prog(a,b) -> eval Map.empty (Seq(b)) |> ignore

            let parseText text = 
                let lexbuf = LexBuffer<_>.FromString  text
                try
                    Parser.Start Lexer.tokenize lexbuf
                with e->
                    let pos = lexbuf.EndPos
                    failwithf "incorrect syntax near line %d" (pos.Line+1)                
            let p = parseText txt
            evaluateAst programmable p
            event.Trigger(Log(1, "Execution finished succesfully"))
        with e->
            event.Trigger(Log(2,"Error: " + e.Message))//+"\n"+e.StackTrace)
    let ExecuteAsync txt programmable observer =
        let f = async{ Execute txt programmable observer}
        Async.Start f